home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CompInfo( 23946822001.psc / FileVersion.cls < prev   
Encoding:
Visual Basic class definition  |  2001-07-22  |  8.2 KB  |  239 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "FileVersion"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '
  15. '   Module          : cShellVersion
  16. '   Description     : Returns the Shell DLL Versions
  17. '   Author          : C. Eswar Santhosh
  18. '   Last Updated    : 14th February, 2000.
  19. '   Notes           : Many Shell DLLs export the function DllGetVersion. These include Shell32.dll, ShlWapi.dll, Comctl32.dll
  20. '                     ShDocVw.dll etc.,
  21. '
  22. '   Copyright Info  :
  23. '
  24. '   This Class module is provided AS-IS. This Class module can be used as a part of a compiled
  25. '   executable whether freeware or not. This Class module may not be posted to any web site
  26. '   or BBS or any redistributable media like CD-ROM without the consent of the author.
  27. '
  28. '   Web Site : http://eswar_santhosh.tripod.com
  29. '
  30. '   e-mail   : eswar_santhosh@yahoo.com
  31. '
  32. '   Revision History :
  33. '
  34. '
  35. '-------------------------------------------------------------------------------------------------------------
  36.  
  37. Option Explicit
  38.                                                     
  39. '
  40. ' API Constants
  41. '
  42. Private Const NOERROR As Long = 0                       ' Result
  43.  
  44. ' Format Message Constants
  45. Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
  46. Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  47.  
  48. ' For Version Information
  49. Private Const MAX_PATH As Long = 260
  50. Private Const VOS_NT As Long = &H40000
  51.  
  52. '
  53. ' API Types
  54. '
  55. Private Type DLLVERSIONINFO
  56.     cbSize As Long
  57.     dwMajorVersion As Long
  58.     dwMinorVersion As Long
  59.     dwBuildNumber As Long
  60.     dwPlatformID As Long
  61. End Type
  62.  
  63. ' Supported by Version 5.0 or higher of Shlwapi.dll
  64. Private Type DLLVERSIONINFO2
  65.     Info1 As DLLVERSIONINFO
  66.     dwFlags As Long             ' Currently, reserved and must be set to zero.
  67.     ullVersion As Currency      ' Encoding of the 4 Bytes : [Major] [Minor] [Build] [QFE]
  68. End Type
  69.  
  70. ' For Older guys, this is the one that works
  71. Private Type VS_FIXEDFILEINFO
  72.         dwSignature As Long
  73.         dwStrucVersion As Long         '  e.g. 0x00000042 = "0.42"
  74.         dwFileVersionMS As Long        '  e.g. 0x00030075 = "3.75"
  75.         dwFileVersionLS As Long        '  e.g. 0x00000031 = "0.31"
  76.         dwProductVersionMS As Long     '  e.g. 0x00030010 = "3.10"
  77.         dwProductVersionLS As Long     '  e.g. 0x00000031 = "0.31"
  78.         dwFileFlagsMask As Long        '  = 0x3F for version "0.42"
  79.         dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
  80.         dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
  81.         dwFileType As Long             '  e.g. VFT_DRIVER
  82.         dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
  83.         dwFileDateMS As Long           '  e.g. 0
  84.         dwFileDateLS As Long           '  e.g. 0
  85. End Type
  86.  
  87. '
  88. ' API Declarations (This direct declarations avoid using the unreliable CreateThread to call the function)
  89. '
  90. Private Declare Function FormatMessage Lib "kernel32" Alias _
  91. "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, _
  92. ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
  93. ByVal lpBuffer As String, ByVal nSize As Long, _
  94. Arguments As Long) As Long
  95.  
  96. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  97. (Destination As Any, Source As Any, ByVal Length As Long)
  98.  
  99. ' For the Classic approach
  100. Private Declare Function GetSystemDirectory Lib "kernel32" _
  101. Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) _
  102. As Long
  103.  
  104. Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
  105. Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) _
  106. As Long
  107.  
  108. Private Declare Function GetFileVersionInfo Lib "version.dll" _
  109. Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, _
  110. ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
  111.  
  112. ' The win32api.txt declaration is wrong.
  113. Private Declare Function VerQueryValue Lib "version.dll" _
  114. Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
  115. lplpBuffer As Any, _
  116. puLen As Long) As Long
  117.  
  118. Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
  119.    (dest As Any, ByVal Source As Long, ByVal Length As Long)
  120.  
  121. Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
  122.    (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
  123.  
  124. '
  125. ' Local Variables
  126. '
  127. Dim mCompanyName As String         '
  128. Dim mFileDescription As String     '
  129. Dim mFileVersion As String
  130. Dim mInternalName As String        '
  131. Dim mLegalCopyright As String      '
  132. Dim mOriginalFileName As String    '
  133. Dim mProductName As String         '
  134. Dim mProductVersion As String      '
  135. Dim md As Date
  136. Dim mt As Date
  137.  
  138. Dim arrInfo() As Byte
  139. Dim strLang As String
  140. Dim lInfosize As Long
  141. Dim lpInfoBlock As Long
  142.  
  143. Dim mresult
  144.  
  145. Dim m_Major As Long             ' Major Version
  146. Dim m_Minor As Long             ' Minor Version
  147. Dim m_BuildNumber As Long       ' Build Number
  148. Dim m_QFEVersion As Long        ' QFE Number
  149. Dim m_PlatformID As String ' Platform for which the DLL was written
  150. Public Property Get FileDate() As String
  151.     FileDate = md
  152. End Property
  153. Public Property Get FileTime() As String
  154.     FileTime = mt
  155. End Property
  156. Public Property Get OriginalFileName() As String
  157.     OriginalFileName = mOriginalFileName
  158. End Property
  159. Public Property Get FileDescription() As String
  160.     FileDescription = mFileDescription
  161. End Property
  162. Public Property Get CompanyName() As String
  163.     CompanyName = mCompanyName
  164. End Property
  165. Public Property Get InternalName() As String
  166.     InternalName = mInternalName
  167. End Property
  168. Public Property Get LegalCopyright() As String
  169.     LegalCopyright = mLegalCopyright
  170. End Property
  171. Public Property Get ProductName() As String
  172.     ProductName = mProductName
  173. End Property
  174. Public Property Get ProductVersion() As String
  175.     ProductVersion = mProductVersion
  176. End Property
  177. Public Property Get FileVersion() As String
  178.     FileVersion = mFileVersion
  179. End Property
  180. Public Property Get MajorVersion() As Long
  181. Attribute MajorVersion.VB_Description = "Returns the Major Version of the Shell DLL"
  182.     MajorVersion = m_Major
  183. End Property
  184. Public Property Get MinorVersion() As Long
  185. Attribute MinorVersion.VB_Description = "Returns the Minor Version of the Shell DLL"
  186.     MinorVersion = m_Minor
  187. End Property
  188. Public Property Get BuildNumber() As Long
  189. Attribute BuildNumber.VB_Description = "Build Number of the Shell DLL"
  190.     BuildNumber = m_BuildNumber
  191. End Property
  192. Public Property Get QFEVersion() As Long
  193. Attribute QFEVersion.VB_Description = "QFE Version of the Shell DLL if supported."
  194.     QFEVersion = m_QFEVersion
  195. End Property
  196. Public Property Get Platform() As String
  197.     Platform = m_PlatformID
  198. End Property
  199. Public Sub GetVersionClassic(ByVal LibName As String)
  200. '
  201. ' In this case, these DLLs have only one folder where they reside, the System Folder
  202. '
  203. Dim mBuffer As String, mVerSize As Long, Dummy As Long, mVerInfo() As Byte
  204. Dim mFixedFileInfo As VS_FIXEDFILEINFO, ptrBufferAddress As Long, lenBlock As Long
  205.  
  206. mBuffer = Space$(MAX_PATH)
  207.  
  208. GetSystemDirectory mBuffer, Len(mBuffer)
  209.  
  210. mBuffer = Left$(mBuffer, InStr(mBuffer, Chr$(0)) - 1)
  211. mBuffer = mBuffer & "\" & LibName
  212.  
  213. If Dir(mBuffer) = "" Then
  214.     Err.Raise 28001, App.Title & "File Version", "File was not found : " & LibName
  215.     Exit Sub
  216. End If
  217.  
  218. md = DateValue(FileDateTime(mBuffer))
  219. mt = TimeValue(FileDateTime(mBuffer))
  220.  
  221. ' Dummy will be set to zero by the function
  222. mVerSize = GetFileVersionInfoSize(mBuffer, Dummy)
  223.  
  224. If mVerSize = 0 Then      ' This error will *never* happen
  225.     Err.Raise 28002, App.Title & "File Version", "Version Information Resource not found"
  226. End If
  227.  
  228. ReDim mVerInfo(mVerSize)
  229.  
  230. GetFileVersionInfo mBuffer, 0&, mVerSize, mVerInfo(0)
  231.  
  232. ' Request the Root Block which returns a VS_FIXED_FILE_INFO Structure
  233. VerQueryValue mVerInfo(0), "\", ptrBufferAddress, lenBlock
  234.  
  235. ' Now ptrBufferAddress contains the Address of the VS_FIXED_FILE_INFO Block.
  236. CopyMemory mFixedFileInfo, ByVal ptrBufferAddress, LenB(mFixedFileInfo)
  237.  
  238. ' We are intereO2
  239.  trL